perm filename OLDXAP[XAP,BGB] blob
sn#044851 filedate 1973-05-30 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00033 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 TITLE XAP - XEROX ASSEMBLE AND PRINT - BGB - 27 JANUARY 1973.
C00008 00003 XGP RASTER PAGE BUFFER.
C00010 00004 ALTERNATE PDP-10 MNEMONICS.
C00013 00005 START ADDRESS ENTRY.
C00015 00006 RUN SCANNER OVER EACH PAGE FOUR FUCKING TIMES.
C00018 00007 SUBR(XXTEXT) EXECUTE TEXT CHARACTER.
C00020 00008 SUBR(XXCOMM) EXECUTE COMMAND CHARACTER.
C00021 00009 SUBR(MKTABL) MAKE 2D BIT ADDRESSING TABLE.
C00025 00010 SUBR(XGPOUT) OUTPUT BUFFER TO XGP FROM SECONDARY STORAGE.
C00028 00011 SUBR(PRINT)CHR PLACE A GLYPH INTO XGP BUFFER AT ROW,COL.
C00031 00012 SUBR(MKSEG0) MAKE LINE SEGMENT. CLIPPER.
C00034 00013 SUBR(MKSEG1) MAKE LINE SEGMENT.
C00037 00014 SUBR(IIISIM) OUTPUT III BUFFER ONTO XGP.
C00039 00015 FETCH AND DECODE III COMMAND WORD.
C00041 00016
C00044 00017 SUBR(GETFIL) GET FILE SPEC FROM TTY LINE.
C00046 00018 SUBR(INITIO) GET AND OPEN A CHANNEL.
C00047 00019 SUBR(GETCHR) GET CHARACTER AND SKIP.
C00050 00020 SUBR(INITXT) INITIALIZE TEXT FILE.
C00051 00021 SUBR(DEFONT) DEFINE FONT N.
C00053 00022 SUBR(SETFNT) SETUP A FONT.
C00054 00023 --- ASCII 00 TO 37.
C00055 00024 --- ASCII 40 TO 77.
C00056 00025 --- ASCII 100 TO 137. UPPER CASE COMMANDS.
C00058 00026 --- ASCII 140 TO 177. LOWER CASE COMMANDS.
C00059 00027 COMMAND EXECUTION.
C00062 00028 SUBR(MODE0)
C00067 00029 SUBR(SQRT)
C00069 00030 BEGIN SINCOS SINE & COSINE - BGB.
C00071 00031 SUBR(REALIN)
C00074 00032 SUBR(DPYDOT)X,Y DISPLAY A DOT.
C00075 00033 SUBR(XCONIC)
C00076 ENDMK
C⊗;
TITLE XAP - XEROX ASSEMBLE AND PRINT - BGB - 27 JANUARY 1973.
;JOB DATA AREA AND CORE MAP.
PDL: BLOCK 100 ;CONTROL PUSH DOWN.
PAT: BLOCK 100 ;PATCH AREA.
EXTERN JOBJDA ;140 END OF JOB DATA AREA.
EXTERN JOBFF ;121 TOP OF USED CORE POINTER.
EXTERN JOBSA ;120 XWD ORGINAL-TOP,START-ADDR.
EXTERN JOBREL ; 44 PHYSICAL TOP OF CORE IMAGE.
;XAP SCANNER STATUS.
MODE:0 ;-1 COMMAND MODE. 0 TEXT MODE.
CHAR:0 ;CURRENT CHARACTER.
;DSK I/O DATA AREA.
FILNAM: 0 ;FILE NAME.
EXTION: 0↔0 ;EXTENSION.
PPPN: 0↔0 ;PROJECT-PROGRAMMER.
IOPTR: 0 ;POINTER INTO FILE STACK
MAXFIL←←5
IBUF: BLOCK 4*5 ;FILE STACK, 5 FILES MAX.
CHANTB←IBUF+3
TTYFLG: 0 ;INPUT FROM TTY
RPGFLG: 0
TXTPTR: IOWD 44,TXTPDL
TXTPDL: BLOCK 44 ;PUSH DOWN OF TEXT POINTERS.
;FONT SPECIFICATION.
FONT: 0
FONTAB: BLOCK 20
FNTPPN: SIXBIT/XGPSYS/ ;DEFAULT FONT PPN
;XGP RASTER PAGE BUFFER.
ROW:0↔COL:0 ;XGP "PEN" POSITION.
DROW:0↔DCOL:0 ;DELTA PEN POSITION FOR LINE FEED AND SPACE.
QPAGE:0 ;QUARTER PAGE: 0, 1, 2, 3.
QLO:0↔QHI:0 ;QUARTER ROW LOW & QUARTER ROW HI.
ORGXGP:0 ;XGP BUFFER (1/4 OF A PAGE).
ENDXGP:0
;XGP RASTER DIMENSIONS.
WWIDTH←←=49 ;WORD WIDTH OF A ROW.
NCOLS←←(WWIDTH-1)*=36 ;NUMBER OF COLUMNS IS 1728.
MROWS←←=2048 ;NUMBER OF ROWS IS 2048.
BUFSIZ←←WWIDTH*MROWS/4 ;SIZE OF XGP BUFFER (ONE QUARTER PAGE).
;III BUFFER DISPLAY.
IIIDX: =1024
IIIDY: =1024
ROTDEL:0
SINE:0↔COSINE:1.0 ;ORIENTATION.
SCALEX:1.0↔SCALEY:1.0 ;DILATION.
;TEXT JUSTIFICATION PARAMETERS.
RMAR:NCOLS↔LMAR:=100
ROWMIN:=100↔ROWMAX:MROWS
;ALTERNATE PDP-10 MNEMONICS.
DEFINE O(A,B){OPDEF A[B]}
O LIP,HLR↔O LAP,HRR↔O DIP,HRLM↔O DAP,HRRM
O ZIP,HRRZS↔O ZAP,HLLZS↔O WIP,HRROS↔O WAP,HRRZS
O CAR,HLRZ↔O LIPI,HRLI↔O LAPI,HRRI↔O DIPZ,HRLZM
O CDR,HRRZ↔O LACI,MOVEI↔O SLACI,MOVSI↔O DAPZ,HRRZM
O LAC,MOVE↔O LACN,MOVN↔O LACM,MOVM↔O SLAC,MOVS
O DAC,MOVEM↔O DACN,MOVNM↔O DACM,MOVMM↔O SDAC,MOVSM
O NIP,HLRE↔O NAP,HRRE↔O NIM,HRREI↔O GO,JRST
O FLOAT,FSC 233↔O FIXX,FIX 233000↔O DZM,SETZM
;SAIL LIKE SUBROUTINE LINKAGE.
↓P←←17
DEFINE SUBR(NAME){INTERN NAME↔↓NAME: ;}
DEFINE CALL(NAME,X1,X2,X3,X4){
IFDIF <> <X1> {PUSH 17,X1↔IFDIF <> <X2> {PUSH 17,X2
IFDIF <> <X3> {PUSH 17,X3↔IFDIF <> <X4> {PUSH 17,X4}}}}
PUSHJ 17,NAME}
DEFINE ARG1<-1(17)>↔DEFINE ARG2<-2(17)>
DEFINE ARG3<-3(17)>↔DEFINE ARG4<-4(17)>
DEFINE SETQ(VAR,LIST){CALL(LIST)↔DAC 1,VAR}
;RETURN FROM AN N-ARGUMENT SUBROUTINE CALL.
DEFINE POP0J <POPJ 17,>
↓POP1J.:SUB 17,[2(2)]↔GO@2(17)↔DEFINE POP1J<GO POP1J.>
↓POP2J.:SUB 17,[3(3)]↔GO@3(17)↔DEFINE POP2J<GO POP2J.>
↓POP3J.:SUB 17,[4(4)]↔GO@4(17)↔DEFINE POP3J<GO POP3J.>
↓POP4J.:SUB 17,[5(5)]↔GO@5(17)↔DEFINE POP4J<GO POP4J.>
;ACCUMULATOR AND TEMPORARY DATA MANAGEMENT.
DEFINE ACCUMULATORS(LIST){ACPTR←←2
FOR AC⊂(LIST)<AC←ACPTR↔ACPTR←←ACPTR+1↔>}
DEFINE DECLARE (LIST){
FOR VARNAM⊂(LIST)<VARNAM: 0↔>}
;FATAL ERROR MESSAGE.
DEFINE FATAL(STR){PUSHJ 17,FATAL.↔ASCIZ/STR/}
FATAL.:OUTSTR[BYTE(7)15,12(21)"FAT"↔"AL - "⊗1↔0]
OUTSTR @(17)↔INCHRW↔GO .-1↔LIT
DEFINE CRLF{OUTSTR[BYTE(7)15,12]}
%←←400000
;START ADDRESS ENTRY.
SA: TDCA↔SETA↔DAC RPGFLG↔CALLI ;SET RPG FLAG.
CAR JOBSA↔DAC JOBFF↔CORE↔JFCL ;CORE DOWN LOWER.
LACI =2047↔CORE2↔GO[FATAL(<CAN'T GET A 2ND SEGMENT.>)]
LAC P,[IOWD 100,PDL] ;INITIALIZE TABLES
SETZM FONTAB
LAC[XWD FONTAB,FONTAB+1]↔BLT FONTAB+9
SETZM LMAR↔LACI NCOLS↔DAC RMAR
;RE-ENTRY ADDRESS.
REE: LACI .↔DAC 124
LACI 4↔MOVNM IOPTR
SKIPE RPGFLG↔JFCL ;RPG ENTRY.
;INITIALIZE XGP BUFFER.
LACI 0↔UFBGET↔GO .+3
LACI 1↔UFBGET↔GO[FATAL(<CAN'T GET FASTBANDS.>)]
CDR JOBFF↔DAC ORGXGP↔CALL(MKTABL)
LAC[SIXBIT/LPTFNT/]↔HLLZM FILNAM↔DIPZ EXTION
LAC FNTPPN↔DAC PPPN↔DZM FONT
CALL(<DEFONT+1>) ;DEFINE DEFAULT FONT.
CALL(MKBUF) ;MAKE XGP BUFFER.
;RUN SCANNER OVER EACH PAGE FOUR FUCKING TIMES.
DZM QPAGE↔DZM QLO
LACI =511↔DAC QHI
;RESCAN COMMAND LINE FOR A SEMI-COLON.
RETTY: RESCAN↔INCHSL↔EXIT
CAIN 15↔EXIT
CAIE";"↔GO .-5
;DEFAULT INITIALIZE MARGINS.
LACI =100↔DAC ROWMIN↔DAC ROW
LACI MROWS-=200↔DAC ROWMAX
LACI =100↔DAC LMAR↔DAC COL
LACI NCOLS↔DAC RMAR
SETOM TTYFLG ;FROM TTY.
SETOM MODE ;COMMAND MODE.
;CLEAR XGP QUARTER-PAGE BUFFER.
LAC ORGXGP↔DZM@↔DIP↔AOS↔BLT@ENDXGP
;____________________________________________________________________
LOOP: CALL(GETCHR)↔GO FINISH ;EOF
DAC 1,CHAR
SKIPE MODE↔GO COMAND
CALL(XXTEXT)↔GO LOOP ;TEXT CHARACTERS.
COMAND: CALL(XXCOMM)↔GO LOOP ;COMMAND CHARACTERS.
;DRUM OUT A QUARTER-PAGE.____________________________________________
FINISH: LAC 1,QPAGE
LAC[0↔=784↔=1568↔0](1)↔DAC SECTOR
LAC ORGXGP↔DAC BUFPTR↔LACI =25088↔DAC WRDCNT
LAC[0↔0↔0↔1](1)↔DAC BAND
FBWRT BUFPTR↔OUTSTR[ASCIZ/WARNING: FB WRITE ERROR./]
;TEST FOR END OF PAGE (OR END OF DOCUMENT).__________________________
LACI =512↔ADDM QLO↔ADDM QHI
AOS 1,QPAGE↔CAIGE 1,4↔GO RETTY
CALL(XGPOUT)↔CALLI 0 ;FLUSH BUFFERS
LAC JOBFF↔CORE↔JFCL ;FLUSH CORE.
SETZ↔CORE2↔JFCL
EXIT
;____________________________________________________________________
SUBR(XXTEXT) ;EXECUTE TEXT CHARACTER.
BEGIN XXTEXT;_____________________________________________________
SKIPN 1,CHAR↔POP0J ;NULL.
CAIN 1,11↔GO[LAC COL↔SUB LMAR↔IDIV DCOL ;TAB.
ANDCMI 7↔ADDI 8↔IMUL DCOL↔ADD LMAR
DAC COL↔POP0J]
CAIN 1,15↔GO[LAC LMAR↔DAC COL↔POP0J] ;RETURN.
CAIN 1,14↔GO FFEED
CAIN 1,40↔GO SPACE
CAIN 1,12↔GO[LAC DROW↔ADDM ROW↔GO ROWCHK] ;LINE FEED
CAIN 1,32↔GO ESCAPE ;TILDE ESCAPE TEXT MODE.
CAIN 1,177↔GO MODE0 ;RUBOUT ESCAPE.
;ENTRY POINT FOR HIDDEN CHARACTERS
↑HIDDEN:CALL(PRINT,CHAR)↔GO COLCHK
SPACE: LAC DCOL↔ADDM COL
↑COLCHK:LAC COL↔CAMG RMAR↔GO ROWCHK ;COLUMN OVERFLOW - DEFAULT CRLF.
LAC LMAR↔DAC COL
LAC DROW↔ADDM ROW
↑ROWCHK:LAC ROW↔CAMGE ROWMAX↔POP0J ;ROW OVERFLOW -DEFAULT FF.
FFEED: CALL(XGPOUT) ;FORM FEED.
LAC ROWMIN↔DAC ROW
LAC LMAR↔DAC COL↔POP0J
ESCAPE: SETOM MODE↔POP0J
BEND XXTEXT;BGB 25 MAY 1973.______________________________________
SUBR(XXCOMM) ;EXECUTE COMMAND CHARACTER.
BEGIN XXCOMM;_____________________________________________________
SKIPN 1,CHAR↔POP0J
CDR 1,A00(1)
JUMPN 1,(1)
POP0J
BEND XXCOMM;BGB 25 MAY 1973.______________________________________
SUBR(MKTABL) ;MAKE 2D BIT ADDRESSING TABLE.
;TWO DIMENSION BIT ADDRESSING.
DEFINE DOT(R,C){HLLZ 1,%(C)↔ROT 1,6↔HRRI 1,@%(R)↔DPB 0,1}
COMMENT ⊗
The DOT macro places a bit at a given row and column of the
XGP buffer. The 2D bit address byte pointer is computed by twice
referencing a 2K table in which the Nth word contains the bytes
0:5(N div =36) 6:11(N mod =36) 12:17(01) 18:35(orgXGP+N*WWIDTH).
That is the left halfword of the Nth table entry contains the base
address of the Nth row; and the right halfword of the Nth table
entry contains a byte pointer to the Nth column. In the DOT macro,
the HLLZ and ROT instructions setup the column byte pointer and the
HRRI instruction (thru the magic of immediate indirect double
indexing) adds the right halfword of the Nth row table entry to the
byte pointer. The use of accumulator 1 is mandatory because of the
index-byte-size pun. The following subroutine initializes the table.⊗
BEGIN MKTABL;________________________________________________________
LAC[XWD L,1]↔BLT 11
LAC ORGXGP↔ADDI 2↔TLO 4301↔PUSHJ P,3
LAP ORGXGP↔ADDI 2↔LIPI 2,-=512↔PUSHJ P,3
LAP ORGXGP↔ADDI 2↔LIPI 2,-=512↔PUSHJ P,3
LAP ORGXGP↔ADDI 2↔LIPI 2,-=512↔GO 3
L: XWD -100,WWIDTH ;1 INCREMENT.
XWD -=512,% ;2 AOBJN TABLE POINTER.
DAC 0,(2) ;3
TLNN 0,7700 ;4 TEST FOR =36 OVERFLOW.
ADD 0,[144B11] ;5 INCREMENT COLUMN WORD COUNT.
ADD 0,1 ;6
AOBJN 2,3 ;7
POP0J ;8
BEND MKTABL;BGB 24 MAY 1973._________________________________________
SUBR(MKBUF) MAKE XGP BUFFER (ONE PHASE) 512 ROWS.
BEGIN MKBUF;------------------------------------------------------
;EXPAND CORE FOR XGP BUFFER.
CDR JOBFF↔DAC ORGXGP
ADDI BUFSIZ↔DAC ENDXGP↔AOS ORGXGP
ADDI 10↔DAC JOBFF↔IORI 1777
CALLI 11↔GO [FATAL(CAN'T GET CORE FOR XGP BUFFER)]
;CLEAR XGP BUFFER.
LAC 1,ORGXGP↔SETZM(1)
DIP 1,1↔AOS 1↔BLT 1,@ENDXGP
POP0J
BEND MKBUF;BGB 27 JANUARY 1973.-----------------------------------
SUBR(XGPOUT) OUTPUT BUFFER TO XGP FROM SECONDARY STORAGE.
BEGIN XGPOUT;-----------------------------------------------------
BSIZ ←← =6272 ↔ BCNT ←← =16 ;BUFFER SIZE & NUMBER OF THEM.
SETZ 1,↔SEGNUM 1,↔DAC 1,MYSEG#↔DETSEG↔LOCK;DETACH SEGMENT.
OUTSTR[ASCIZ/PAGE TO XGP.../]
LAC ORGXGP↔DAC BUFORG↔ADDI 3*BSIZ↔DAC BUFEND
CAMLE JOBREL↔CORE↔JFCL
DZM BAND↔DZM SECTOR↔LAC BUFORG↔DAC BUFPTR
;XGP OUTPUT ONE PAGE.
INIT 2,117↔SIXBIT/XGP/↔0↔GO[OUTSTR[ASCIZ/XGP INIT FAILED.
/]↔ POP0J]↔LOCK↔LACI 3,BCNT ;THIS MANY DRUM BUFFERS PER PAGE.
;READ DRUM.
L1: LACI BSIZ↔DAC WRDCNT↔LAC BAND
FBREAD BUFPTR↔OUTSTR[ASCIZ/FAST BAND READ ERROR. /]
LACI =196↔ADDB SECTOR↔CAIG =2156↔GO .+3↔DZM SECTOR↔AOS BAND
;PUT XGP CONTROL WORD IN EACH ROW.
LAC[1B11+=48]↔LAC 1,BUFPTR↔LACI 2,=128
DAC(1)↔ADDI 1,=49↔SOJG 2,.-2
CAIE 3,BCNT↔GO L2
OUT 2,CUTARG↔SKIPA↔JFCL
;PRINT ON XGP.
L2: SLACI -BSIZ↔LAP BUFPTR↔SOS↔ASH 3,1↔DAC DUMARG(3)
OUT 2,DUMARG(3)↔SKIPA↔OUTSTR[ASCIZ/XGP ERROR /]↔ASH 3,-1
CAIE 3,1↔GO L3
OUT 2,CUTARG↔SKIPA↔JFCL↔GO L4
;ADVANCE TO NEXT BUFFER.
L3: LACI BSIZ↔ADDB BUFPTR↔CAMGE BUFEND↔GO L4
LAC BUFORG↔DAC BUFPTR
L4: SOJG 3,L1↔UNLOCK↔RELEASE 2,↔OUTSTR[ASCIZ/FINISHED./]↔CRLF
LAC 1,MYSEG↔JUMPE 1,.+3 ;RE-ATTACH SEGMENT.
ATTSEG 1,↔GO[OUTSTR[ASCIZ/ATTSEG FAILED. /]↔HALT .+1]
POP0J
;____________________________________________________________________
BUFORG:0↔BUFEND:0 ;XGP BUFFERS.
CUTARG: IOWD 2,HACK↔0
DUMARG:BLOCK BSIZ*2 + 4
HACK: 1B0+=30B11↔0 ;CHOP PAPER.
BEND XGPOUT;BGB 28 MAY 1973.--------------------------------------
BAND:0↔BUFPTR:0↔WRDCNT:=12544↔SECTOR:0 ;FB UUO ARGUMENT.
SUBR(PRINT)CHR PLACE A GLYPH INTO XGP BUFFER AT ROW,COL.
BEGIN PRINT;------------------------------------------------------
ACCUMULATORS{G,B,B2,M,N,I}
LAC 1,FONT ;CURRENT FONT NUMBER.
SKIPN 2,FONTAB(1)↔POP1J ;FONT BASE ADDRESS.
LAC I,203(2) ;ROWS BETWEEN TOP AND BASE LINE.
ADD 2,ARG1 ;POINTER INTO FONT'S CHARACTER TABLE.
CAR N,(2) ;COLS WIDE OF THE GLYPH.
CDR G,(2)↔JUMPE G,POP1J.;EXIT WHEN NO CHARACTER.
ADD G,FONTAB(1)↔AOS G ;CHARACTER'S GLYPH POINTER.
CDR M,(G) ;ROWS HIGH OF THE GLYPH.
CAR 0,(G) ;ROWS FROM TOP TO FIRST ROW OF GLYPH.
SUB 0,I ;ROWS ABOVE CURRENT XGP PEN POSITION.
ADD 0,ROW↔SUB 0,QLO
IMULI WWIDTH
ADD ORGXGP↔DAPZ B ;WORD POINTER INTO XGP BUFFER.
LAC 0,COL↔IDIVI 0,=36 ;REMAINDER IN AC-1 !
AOS↔ADD B,0↔DAC B,B2 ;WORD POINTER INTO XGP BUFFER.
ADDM N,COL ;UPDATE XGP PEN COLUMN POSITION.
TLO G,444400↔AOS G ;SETUP GLYPH BYTE POINTER.
CAILE N,=36↔GO[
IDIVI N,=36↔AOJA N,L0] ;WHEN CHARACTER WIDTH ≥ =36.
DPB N,[POINT 6,G,11] ;SIZE OF BYTE.
ADD 1,N↔SUBI 1,=36 ; =36 - CHRWID - REMAINDER
LACI N,1
L0: MOVNS 1↔DAP 1,L3 ;BYTE POSITION WITH RESPECT TO WORD BOUNDARYS.
;INCLUSIVE OR GLYPH BITS INTO THE XGP BUFFER.
L1: LAC I,N
L2: ILDB 0,G↔SETZ 1,
L3: LSHC 0,0
CAML B,ORGXGP↔CAMLE B,ENDXGP↔SKIPA↔IORM 0,(B)
AOS B↔JUMPE 1,L4
CAML B,ORGXGP↔CAMLE B,ENDXGP↔SKIPA↔IORM 1,(B)
L4: SOJG I,L2↔LAC B,B2
ADDI B,WWIDTH↔DAC B,B2
SOJG M,L1↔POP1J
BEND PRINT;BGB 23 MAY 1973.---------------------------------------
SUBR(MKSEG0) MAKE LINE SEGMENT. CLIPPER.
BEGIN MKSEG0;_____________________________________________________
ACCUMULATORS{R1,C1,R2,C2,Q,N}
;TEST FOR EASY OUTSIDER.
LAC Q,C1↔LAC N,C2↔CAMLE C1,C2↔EXCH Q,N
CAIG Q,=1727↔SKIPGE N↔POP0J
LAC Q,R1↔LAC N,R2↔CAMLE R1,R2↔EXCH Q,N
CAMG Q,QHI↔CAMGE N,QLO↔POP0J
;TEST FOR EASY INSIDER.
JUMPL C1,L1↔JUMPL C2,L1
CAILE C1,=1727↔GO L1↔CAILE C2,=1727↔GO L1
CAMLE R1,QHI↔GO L1↔CAMLE R2,QHI↔GO L1
CAMGE R1,QLO↔GO L1↔CAMGE R2,QLO↔GO L1↔GO MKSEG1 ;DISPLAY.
;TEST FOR AND HANDLE SIMPLE CASES.
L1: CAMN R1,R2↔GO[
CAMN C1,C2↔POP0J↔GO HSEG]
CAMN C1,C2↔GO VSEG
;MIDPOINT THE HARD CASE.
PUSH P,R1↔PUSH P,C1 ;SAVE 1ST END.
ADD R1,R2↔ASH R1,-1 ;MIDPOINT THE LINE SEGMENT.
ADD C1,C2↔ASH C1,-1
;TEST FOR MIDPOINT AND 1ST END BEING COINCIDANT.
CAMN R1,-1(P)↔GO[
CAME C1, 0(P)↔GO .+1↔POP P,C1↔POP P,R1↔POP0J]
;RECURSION - DISPLAY ONE HALF AND THEN DISPLAY THE OTHER.
CALL(MKSEG0) ;MIDPOINT TO 2ND END.
LAC R2,-1(P)↔LAC C2,0(P)
CALL(MKSEG0) ;MIDPOINT TO 1ST END.
POP P,C1↔POP P,R1↔POP0J
;DISPLAY HORIZONTAL LINE SEGMENT FROM (C1 MIN C2) TO (C1 MAX C2).
HSEG: LAC Q,C1↔LAC N,C2↔CAML C1,C2↔EXCH N,Q
SKIPGE Q↔SETZ Q,↔CAILE N,=1727↔LACI N,=1727↔SUB N,Q
DOT(R1,Q)↔SKIPA↔IDPB 0,1↔SOJG N,.-1↔POP0J
;DISPLAY VERTICAL LINE SEGMENT FROM (R1 MIN R2) TO (R1 MAX R2).
VSEG: LAC Q,R1↔LAC N,R2↔CAML R1,R2↔EXCH N,Q
CAMGE Q,QLO↔LAC Q,QLO↔CAMLE N,QHI↔LAC N,QHI↔SUB N,Q
DOT(Q,C1)↔ADDI 1,WWIDTH
SOJG N,.-2↔POP0J
BEND MKSEG0;BGB 24 APRIL 1973.____________________________________
SUBR(MKSEG1) MAKE LINE SEGMENT.
COMMENT / Recursive midpoint method of quantizing a line segment.
Arguments are expected in accumulators R1, C1, R2, C2; the bit
is deposited from accumulator 0./
BEGIN MKSEG1;_____________________________________________________
ACCUMULATORS{R1,C1,R2,C2,Q,N}
;TEST FOR AND HANDLE SIMPLE CASES.
CAMN R1,R2↔GO[
CAMN C1,C2↔GO[DOT(R1,C1)↔POP0J]↔GO HSEG]
CAMN C1,C2↔GO VSEG
;MIDPOINT THE HARD CASE.
PUSH P,R1↔PUSH P,C1 ;SAVE 1ST END.
ADD R1,R2↔ASH R1,-1 ;MIDPOINT THE LINE SEGMENT.
ADD C1,C2↔ASH C1,-1
;TEST FOR MIDPOINT AND 1ST END BEING COINCIDANT.
CAMN R1,-1(P)↔GO[
CAME C1, 0(P)↔GO .+1↔POP P,C1↔POP P,R1
DOT(R1,C1)↔DOT(R2,C2)↔POP0J]
;RECURSION - DISPLAY ONE HALF AND THEN DISPLAY THE OTHER.
CALL(MKSEG1) ;MIDPOINT TO 2ND END.
LAC R2,-1(P)↔LAC C2,0(P)
CALL(MKSEG1) ;MIDPOINT TO 1ST END.
POP P,C1↔POP P,R1↔POP0J
;DISPLAY HORIZONTAL LINE SEGMENT FROM (C1 MIN C2) TO (C1 MAX C2).
HSEG: LAC Q,C1↔LAC N,C2
CAML C1,C2↔EXCH N,Q↔SUB N,Q
DOT(R1,Q)↔SKIPA↔IDPB 0,1
SOJG N,.-1↔POP0J
;DISPLAY VERTICAL LINE SEGMENT FROM (R1 MIN R2) TO (R1 MAX R2).
VSEG: LAC Q,R1↔LAC N,R2
CAML R1,R2↔EXCH N,Q↔SUB N,Q
DOT(Q,C1)↔ADDI 1,WWIDTH
SOJG N,.-2↔POP0J
BEND MKSEG1;BGB 24 APRIL 1973.____________________________________
SUBR(IIISIM) OUTPUT III BUFFER ONTO XGP.
BEGIN IIISIM______________________________________________________
;DELTA ORIGIN DISPLACEMENT.
SLACI 1,(2B2)↔LAC CHAR
CAIN"*"↔SETZ 1,↔DAC 1,DELTA#
;IIIFILE NAME.
CALL(GETFIL)↔POP0J
CALL(INITIO,[17],[SIXBIT/DSK/],[0])
GO[FATAL(CAN'T INIT DSK)]
DAC 1,IIICHN#
CALL(IO,[LOOKUP FILNAM],IIICHN)↔GO FRET
;EXPAND CORE FOR DUMP INPUT.
LAC JOBREL↔DAC OLD44#
NIP 1,PPPN↔MOVN 1,1
ADD 1,JOBREL↔DAC 1,BUFEND#
CORE 1,↔GO[FATAL(CAN'T EXPAND CORE)]
;SAVE CURRENT BEAM POSITION.
LAC COL↔DAC BEGCOL#
LAC ROW↔DAC BEGROW#
;DUMP III FILE IN.
LAC OLD44↔ADDM PPPN
CALL(IO,[IN PPPN],IIICHN)
LAC 1,OLD44↔ADDI 1,2↔DAC 1,PC# ;III PC.
L1: CDR 1,BUFEND↔DZM -1(1)↔DZM(1)
CAML 1,JOBREL↔GO .+3
LIPI 1,-1(1)↔BLT 1,JOBREL ;CLEAR TOP.
;FETCH AND DECODE III COMMAND WORD.
ILOOP: AOSA 1,PC
LOOP: LAC 1,PC↔CAMLE 1,JOBFF
CAML 1,BUFEND↔GO RET
LAC 2,(1)
TRNE 2,01↔GO XTEXT ;TEXT COMMAND WORD.
TRNE 2,02↔GO XVECTR ;VECTOR COMMAND WORD.
TRNE 2,20↔GO XCTRL ;III CONTROL WORD.
TRNE 2,37↔GO ILOOP ;NOP & HALT COMMANDS.
RET: LAC OLD44↔CORE↔GO[FATAL(CAN'T SHRINK CORE!)]
FRET: CALL(IO,[RELEASE],IIICHN)↔JFCL
LAC BEGCOL↔DAC COL
LAC BEGROW↔DAC ROW
POP0J
;EXECUTE III TEXT.
XTEXT: PUSH P,2 ;-2(P)
PUSH P,[5] ;-1(P)
PUSH P,[POINT 7,-2(P)] ; 0(P)
CLOOP: ILDB 1,0(P)↔JUMPE 1,CCONT
CAIN 1,15↔GO[LAC -4(P)↔DAC COL↔GO CCONT]
CALL(PRINT,1)
CCONT: SOSLE -1(P)↔GO CLOOP
SUB P,[XWD 3,3]
GO ILOOP
;EXECUTE III CONTROL OPERATIONS.
XCTRL: TRNN 2,04↔GO[CAR 1,2↔DAC 1,PC↔GO LOOP] ;JUMP.
TRNE 2,40↔GO LOOP ;SAVE A NOP HERE
AOS 1,PC ;JSR
HRLI 1,20
CAR 2,2
CAMLE 2,JOBFF
CAML 2,BUFEND↔GO[ OUTSTR[ASCIZ/JSR OUT OF BOUNDS
/]↔ GO RET]
DAC 1,(2)↔DAC 2,PC
GO ILOOP
;EXECUTE VECTORS.
XVECTR: TRNN 2,4
GO [TRNN 2,10 ;SHORT VECTOR OR TSS
GO SVECT ;SHORT VECTOR
GO ILOOP] ;TSS
LDB [POINT 11,2,10]↔ROT -13 ;X
ADD DELTA↔MUL IIIDX↔PUSH P,0
LDB [POINT 11,2,21]↔ROT -13↔MOVNS ;Y
ADD DELTA↔MUL IIIDY↔PUSH P,0
LDB 1,[POINT 3,2,31]
PUSHJ P,@PLOTAB(1)
GO ILOOP
SVECT: PUSH P,2
LDB [POINT 7,2,6]↔ROT -7
ADD DELTA↔MUL IIIDX↔PUSH P,0 ;X
LDB [POINT 7,2,13]↔ROT -7↔MOVN
ADD DELTA↔MUL IIIDY↔PUSH P,0 ;Y
LDB 1,[POINT 2,2,15]
PUSHJ P,@PLOTAB(1)
POP P,2
LDB [POINT 7,2,22]↔ROT -7
ADD DELTA↔MUL IIIDX↔PUSH P,0 ;X
LDB [POINT 7,2,29]↔ROT -7↔MOVN
ADD DELTA↔MUL IIIDY↔PUSH P,0 ;
LDB 1,[POINT 2,2,31]
PUSHJ P,@PLOTAB(1)
GO ILOOP
PLOTAB: [RVECT: CALL(RELATE)↔CALL(PLTVEC,1,2)↔POP2J]
[RPNT: CALL(RELATE)↔DAC 1,COL↔DAC 2,ROW↔GO PLTVEC]
[RIVECT: CALL(RELATE)↔DAC 1,COL↔DAC 2,ROW↔POP2J]
RPNT
[AVECT: CALL(ABSOLUTE)↔GO PLTVEC] ;ARGS ARE ALREADY STACKED
[APNT: CALL(ABSOLUTE)↔DAC 1,COL↔DAC 2,ROW↔GO PLTVEC]
[AIVECT: CALL(ABSOLUTE)↔DAC 1,COL↔DAC 2,ROW↔POP2J]
APNT
RELATE: SKIPE DELTA↔MOVSI -200000↔MUL IIIDX
LAC 1,0↔ADD 1,COL↔ADDB 1,-3(P)
SKIPE DELTA↔MOVSI -200000↔MUL IIIDY
LAC 2,0↔ADDB 2,-2(P)↔ADD 1,ROW
POP0J
ABSOLU: LAC 1,BEGCOL↔ADDB 1,-3(P)
LAC 2,BEGROW↔ADDB 2,-2(P)
POP0J
BEND;2/8/73/(TVR)21 MAY 1973(BGB)---------------------------------
PLTVEC: SETO↔LAC 2,ROW↔LAC 3,COL↔LAC 4,ARG1↔LAC 5,ARG2
DAC 4,ROW↔DAC 5,COL↔CALL(MKSEG0)↔POP2J
SUBR(GETFIL) ;GET FILE SPEC FROM TTY LINE.
BEGIN GETFIL;_____________________________________________________
SETZM FILNAM↔SETZM EXTION
SETZM EXTION+1↔SETZM PPPN
LAC 4,[POINT 6,FILNAM,-1]↔LACI 2,6
CALL(GETCHR)↔POP0J
CAIN 1,15↔GO[CALL(GETCHR)↔POP0J↔POP0J]↔AOS(P)
JRST L+2
L: CALL(GETCHR)↔POP0J↔CAIN 1,";"↔POP0J
CAILE 1,"z"↔POP0J
CAIL 1,"a"↔SUBI 1,40 ;CONVERT LOWER CASE
CAIN 1,"."↔GO[LAC 4,[POINT 6,EXTION,-1]↔LACI 2,3↔GO L]
CAIN 1,"["↔GO[LAC 4,[POINT 6,PPPN,-1] ↔LACI 2,3↔GO L]
CAIN 1,","↔GO[CAR PPPN
PUSHJ P,[PPJUST: JUMPE [OUTSTR[ASCIZ/BAD P,PN/]
CLRBFI↔SOS -1(P)↔CRLF↔POP1J]
TRNE 77↔POP0J↔LSH -6↔GO PPJUST]
DIP PPPN↔LAC 4,[POINT 6,PPPN,17]↔LACI 2,3↔GO L]
CAIN 1,"]"↔GO[CDR PPPN↔CALL(PPJUST)
DAP PPPN↔CALL(GETCHR)↔POP0J↔GO FINQ]
FINQ: CAIN 1,15↔GO EOL ;END OF THE LINE.
CAIN 1,12↔POP0J
CAIN 1,"→"↔POP0J
CAIG 1," "↔GO L ;IGNORE GARBAGE.
SOJL 2,L↔SUBI 1,40↔IDPB 1,4↔GO L
EOL: CALL(GETCHR)↔POP0J↔POP0J
BEND;1/31/73,2/7/73(TVR)----------------------------------------------
SUBR(INITIO) GET AND OPEN A CHANNEL.
BEGIN INITIO;_____________________________________________________
MOVEI 1,17 ;SEARCH FOR FREE CHANNEL
SKIPE JOBJDA(1)
SOJGE 1,.-1
JUMPL 1,[OUTSTR[ASCIZ+OUT OF I/O CHANNELS!
+]↔ POP3J]
LAC [ OPEN -3(P)]
DPB 1,[POINT 4,0,12]
XCT 0
POP3J
AOS (P)
POP3J
BEND;2/7/73/(TVR)-------------------------------------------------
SUBR(IO,OPCODE,CHAN)----------------------------------------------
BEGIN IO
LAC -1(P)
DPB [POINT 4,-2(P),12]
XCT -2(P)
POP2J
AOS (P)
POP2J
BEND;2/7/73/(TVR)-------------------------------------------------
SUBR(GETCHR) GET CHARACTER AND SKIP.
BEGIN GETCHR;_____________________________________________________
;TELETYPE.
L1: SKIPN TTYFLG↔GO L2
INCHSL 1↔POP0J
CAIN 1,15↔POP0J
AOS(P)↔POP0J
;DISK.
L2: SKIPGE 1,IOPTR↔GO[SETOM TTYFLG↔GO L1] ;RETURN TO TTY.
SOSLE IBUF+2(1)↔GO RETCHR
CALL(IO,[IN],<CHANTB(1)>)↔GO RETCHR
CALL(IO,[STATO 1B22],<CHANTB(1)>)↔GO[
OUTSTR[ASCIZ/DISK READ ERROR /]↔HALT RETCHR]
CALL(IO,[RELEASE],<CHANTB(1)>) ;EOF.
SUBI 1,4↔DAC 1,IOPTR ;POP A CHANNEL.
GO GETCHR
RETCHR: ILDB 1,IBUF+1(1) ;RETURN A CHARACTER.
AOS(P)↔POP0J ;AND SKIP.
BEND;2/7/73(TVR)--------------------------------------------------
SUBR(GETCHM) GET CHARACTER MUST.
BEGIN GETCHM
CALL(GETCHR)
GO [FATAL(UNEXPECTED EOF)]
POP0J
BEND GETCHM;2/7/73(TVR)-------------------------------------------
SUBR(GETNUM) GET AN INTEGER.
BEGIN GETNUM
SETZM 3↔CALL(GETCHM)
CAIL 1,"0"↔CAILE 1,"9"↔GO[
EXCH 1,3↔POP0J]↔ANDI 1,17
IMULI 3,=10↔ADD 3,1
GO GETNUM+1
BEND GETNUM;_________________________________________________________
SUBR(GET14) GET A 14 BIT NUMBER
BEGIN GET14
CALL(GETCHM)
LSH 1,7
PUSH P,1
CALL(GETCHM)
ADD 1,(P)
POP P,(P)
POP0J
BEND GET14;__________________________________________________________
SUBR(INITXT) INITIALIZE TEXT FILE.
BEGIN INITXT;_____________________________________________________
LACI 2,4↔ADD 2,IOPTR
CAIL 2,4*MAXFILES↔GO[FATAL(INDIRECTION TOO DEEP.)]
LACI IBUF(2)
CALL (INITIO,[0],[SIXBIT/DSK/],0)
GO[FATAL(CAN'T INIT DSK)]
DAC 1,CHANTB(2)
CALL(GETFIL)↔GO L2
LACI 2,4↔ADDB 2,IOPTR
CALL (IO,[LOOKUP FILNAM],<CHANTB(2)>)
GO L2↔GO L4
L2: OUTSTR[ASCIZ/FILE NOT FOUND. /]
LACI 2,4↔SUBM 2,IOPTR
L3: CALL(IO,[RELEASE],<CHANTB(2)>)
L4: AOS(P)↔POP0J
BEND;2/7/73(TVR)--------------------------------------------------
SUBR(DEFONT) DEFINE FONT N.
BEGIN DEFONT;_____________________________________________________
DZM FILNAM
;DISK INITIALIZATION.
PUSH P,[17]↔PUSH P,[SIXBIT/DSK/]↔PUSH P,[0]
PUSHJ P,INITIO↔GO[FATAL(CAN'T INIT DSK)]↔DAC 1,FONTCH
SKIPE FILNAM↔GO L1
CALL(GETCHM)↔ANDI 1,17↔DAC 1,FONT ;FONT NUMERAL.
CALL(GETFIL)↔GO L3 ;FONT FILE NAME.
;FIND FONT FILE.
L1: CALL(IO,[LOOKUP FILNAM],FONTCH)↔GO[
LACI'FNT'↔SKIPN EXTION↔DIPZ EXTION
CALL(IO,[LOOKUP FILNAM],FONTCH)↔GO[
LAC FNTPPN↔SKIPN PPPN↔DAC PPPN
CALL(IO,[LOOKUP FILNAM],FONTCH)↔GO[
OUTSTR[ASCIZ/ FONT NOT FOUND.
/]↔ GO L3]↔GO .+1]↔GO .+1]
L2: LAC 1,FONT ;FONT NUMBER.
LAC MAXADR↔DAC FONTAB(1) ;FONT BASE ADDRESS.
HLL PPPN↔SOS↔DAC INARG ;IOWD DUMP ARGUMENT.
MOVS PPPN↔MOVMS↔ADD MAXADR↔AOS ;TOP OF THE FONT.
DAC MAXADR↔CORE2↔HALT ;EXPAND UPPER SEGMENT.
CALL(IO,[IN INARG]],FONTCH])↔JFCL
CALL(SETFNT)
L3: CALL (IO,[RELEASE],FONTCH)
POP0J
↑FONTCH: 0
MAXADR: %+4000
INARG:0↔0
BEND DEFONT;2/7/73(TVR)2/25/73(BGB)-------------------------------
SUBR(SETFNT) SETUP A FONT.
BEGIN SETFNT;_____________________________________________________
LAC 1,FONT↔CDR 2,FONTAB(1) ;GET FONT BASE ADDRESS.
SKIPN 2↔POP0J ;EXIT WHEN FONT MISSING.
LACI =40↔DAC DROW ;LINE FEED DEFAULT.
SKIPE 1,201(2)↔DAC 1,DROW ;LINE FEED SPECIFIED.
LACI =25↔DAC DCOL ;SPACE DEFAULT.
SKIPE 1,202(2)↔DAC 1,DCOL ;SPACE SPECIFIED.
POP0J
BEND SETFNT;2/7/72(TVR)-------------------------------------------
; --- ASCII 00 TO 37.
A00:
0 ;null. ;00-07.
0 ;"↓"
0 ;"α"
0 ;"β"
0 ;"∧"
0 ;"¬"
0 ;"ε"
0 ;"π"
0 ;"λ" ;10↔17.
0 ;tab.
0 ;LF
0 ;VT.
0 ;FF.
0 ;CR.
0 ;"∞"
0 ;"∂"
0 ;"⊂" ;20-27.
0 ;"⊃"
0 ;"∩"
0 ;"∪"
0 ;"∀"
0 ;"∃"
IIISIM ;"⊗"
0 ;"↔"
0 ;"_" ;30-37.
0 ;"→"
0 ;"~" TILDE.
0 ;"≠"
0 ;"≤"
0 ;"≥"
0 ;"≡"
0 ;"∨"
; --- ASCII 40 TO 77.
0 ;SPACE. ;40-47.
0 ;"!"
0 ;"""
0 ;"#"
0 ;"$"
0 ;"%"
0 ;"&"
0 ;"'"
0 ;"(" ;50-57.
0 ;")"
IIISIM ;"*"
0 ;"+"
0 ;","
0 ;"-"
0 ;"."
0 ;"/"
0 ;"0" ;60-67.
0 ;"1"
0 ;"2"
0 ;"3"
0 ;"4"
0 ;"5"
0 ;"6"
0 ;"7"
0 ;"8" ;70-77.
0 ;"9~
0 ;":~
0 ;";~
0 ;"<"
0 ;"="
0 ;">"
0 ;"?"
; --- ASCII 100 TO 137. UPPER CASE COMMANDS.
REQFIL ;"@" INDIRECT FILE COMMAND ;100-107.
0 ;"A"
0 ;"B"
XCONIC ;"C" CONIC ARCS
0 ;"D"
0 ;"E"
XFONT ;"F" SELECT FONT AND ENTER TEXT MODE.
0 ;"G"
0 ;"H" ;110-117.
AI ;"I" ABSOLUTE INVISIBLE VECTOR.
0 ;"J"
0 ;"K"
0 ;"L"
DEFONT ;"M"
0 ;"N"
XROTAT ;"O" SET ORIENTATION.
0 ;"P" ;120-127.
0 ;"Q"
XRADIAL ;"R"
0 ;"S"
0 ;"T"
0 ;"U"
AV ;"V" ABSOLUTE VISIBLE VECTOR.
0 ;"W"
XXSCAL ;"X" SET X SCALE. ;130-137.
YYSCAL ;"Y" SET Y SCALE.
0 ;"Z"
0 ;"["
0 ;"\"
0 ;"]"
0 ;"↑"
0 ;"←"
; --- ASCII 140 TO 177. LOWER CASE COMMANDS.
0 ;"'" ;140-147.
0 ;"a"
0 ;"b"
0 ;"c"
0 ;"d"
0 ;"e"
0 ;"f"
0 ;"g"
0 ;"h" ;150-157.
0 ;"i"
0 ;"j"
0 ;"k"
0 ;"l"
0 ;"m"
0 ;"n"
0 ;"o"
0 ;"p" ;160-167.
0 ;"q"
0 ;"r"
0 ;"s"
0 ;"t"
0 ;"u"
0 ;"v"
0 ;"w"
0 ;"x" ;170-177.
0 ;"y"
0 ;"z"
0 ;"{"
0 ;"|"
0 ;alt
0 ;"}"
0 ;rubout
; COMMAND EXECUTION.
;____________________________________________________________________
;"@" INDIRECT FILE COMMAND.
REQFIL: CALL(INITXT)↔GO[OUTSTR[ASCIZ/ FILE NOT FOUND.
/]↔POP0J]
SETZM TTYFLG ;READ FROM DISK.
SETZM MODE ;ENTER TEXT MODE.
POP0J
;____________________________________________________________________
XFONT: CALL(GETCHM) ;SELECT FONT.
ANDI 1,17↔DAC 1,FONT
SETZM MODE ;ENTER TEXT MODE.
POP0J
;____________________________________________________________________
;ABSOLUTE INVISIBLE VECTOR.
AI: CALL(GETNUM)↔DAC 1,ROW
CALL(GETNUM)↔DAC 1,COL↔POP0J
;____________________________________________________________________
;ABSOLUTE VISIBLE VECTOR.
AV: CALL(GETNUM)↔DAC 1,4
CALL(GETNUM)↔DAC 1,5
SETO
LAC 2,ROW↔LAC 3,COL
DAC 4,ROW↔DAC 5,COL
CALL(MKSEG0)↔POP0J
XRADIAL:
OUTCHR["R"]
CALL(GETNUM)↔DAC 1,5↔FLOAT 5,↔DAC 5,4
CALL(GETNUM)↔DAC 1,3↔FLOAT 3,↔DAC 3,2
FMP 2,SINE↔MOVNS 2↔FIXX 2,↔ADD 2,ROW
FMP 4,SINE↔MOVNS 4↔FIXX 4,↔ADD 4,ROW
FMP 3,COSINE↔FIXX 3,↔ADD 3,COL
FMP 5,COSINE↔FIXX 5,↔ADD 5,COL
SETO↔CALL(MKSEG0)↔POP0J
;____________________________________________________________________
;III DISPLAY SCALE FACTOR.
XXSCAL: CALL(REALIN)↔DAC SCALEX
FMPR[1024.]↔FIXX↔DAC IIIDX
POP0J
YYSCAL: CALL(REALIN)↔DAC SCALEY
FMPR[1024.]↔FIXX↔DAC IIIDY
POP0J
XROTAT: CALL(READARC)↔DAC ROTDEL
SETQ(SINE,{SIN,ROTDEL})
SETQ(COSINE,{COS,ROTDEL})
OUTCHR["O"]↔POP0J
;____________________________________________________________________
SUBR(MODE0)
BEGIN MODE0;
CALL(GETCHR) ;GET MODE 0 ESCAPE
DAC 1,CHAR ;SAVE IT IN CASE ITS A HIDDEN CHARACTER
JUMPE 1,HIDDEN
CAIN 1,1↔GO ESC1
CAIN 1,2↔GO ESC2
CAIL 1,20 ;TREAT '177 '20 THRU '177 '24 AS LINE SPACE
CAILE 1,24
GO [ LAC DCOL↔ADDM COL↔GO COLCHK ]
GO HIDDEN
COMMENT ⊗
XGP ESCAPE 1 ('177&'001) causes the next 7 bits to be read as a special
operation code. The following codes are proposed:
0-17 Font select. The code, 0 to 17 is taken as the font
identification number of the font to use.
20-37 Reserved for future use.
40 XGP Column Selector
The next 14 bits are taken modulo 4096 as the x position
to print at next. (The intention is to allow arbitrary
width spaces for text justification.)
41 XGP Underscore
The next 7 bits are taken as the scan line number on which
to underscore. (Scan line 0 is the first scan-line in the
character). The next 14 bits are taken modulo 4096 as the
length of the underscore.
42 Line space.
This does a line feed and then takes the next 7 bits as the
number of blank lines to insert before the next line.
43 Base-line adjust.
The next 7 bits are taken in two's complement as the base-
line adjustment to the current font. The adjustment sticks
until reset by another adjust command or a font select. The
intention is to allow a font to be used for subscripts and
superscripts. (Increment baseline for superscript, decrement
for subscript).
44 Insert the paper page number. The paper page number is set
to 1 by a form feed. It is incremented each time the paper
is cut. This escape causes the decimal value of this count
to be printed.
45 Accept heading text. The next byte is a count of bytes to
follow. That number of bytes will be read into the heading
line. When that count is exhausted, the heading line will
be printed.
⊗;
ESC1: CALL(GETCHM)
CAIGE 1,20↔GO [ DAC 1,FONT↔POP0J ]
CAIN 1,40↔GO COLSEL
CAIN 1,41↔GO UNDERSCORE
CAIN 1,42↔GO LINESPACE
FATAL(UNIMPLIMENT MODE 0 COMMAND)
COLSEL: CALL(GET14)
DAC 1,COL
GO COLCHK
UNDERSCORE: FATAL(UNDERSCORE UNIMPLIMENTED)
LINESPACE: CALL(GETCHM)
ADD DROW
ADDM ROW
GO ROWCHK
COMMENT ⊗
XGP ESCAPE 2 ('177&'002) causes the next 7 bits to be taken as the column
increment. This quantity is signed: 0-77 are positive increments 100
to 177 are negative increments (100 → -100, 177 → -1).
The escape significance of codes 3 through 10, 13, and 16 through 37 is not
defined at the present time but reserved for future use.
⊗;
ESC2: CALL(GETCHM)
CAIL 1,100
OR 1,[ 777777777700 ]
ADDM 1,COL
GO COLCHK
BEND MODE0;
;SUBR(SQRT)
SUBR(SQRT)--------------------------------------------------------
BEGIN SQRT;MODIFIED OLDE LIB40 SQUARE ROOT - BGB - TRADITIONAL.
A←0 ↔ B←1 ↔ C←2
MOVM B,ARG1↔JUMPE B,POP1J.↔PUSH P,2
;LET X=F*(2↑2B) WHERE 0.25<F<1.00 THEN SQRT(X)=SQRT(F)*(2↑B).
ASHC B,-=27↔SUBI B,201 ;GET EXPONENT IN B, FRACTION IN C.
ROT B,-1 ;CUT EXP IN HALF, SAVE ODD BIT
HRRM B,L↔LSH B,-=35 ;USE THAT ODD BIT.
ASH C,-10↔FSC C,177(B) ;0.25 < FRACTION < 1.00
;LINEAR APPROXIMATION TO SQRT(F).
MOVEM C,A
FMP C,[0.8125↔0.578125](B)
FAD C,[0.302734↔0.421875](B)
;TWO ITERATIONS OF NEWTON'S METHOD.
MOVE B,A
FDV B,C↔FAD C,B↔FSC C,-1
FDV A,C↔FADR A,C
L: FSC A,0↔MOVE 1,A↔POP P,2
POP1J↔LIT
BEND;28/12/72-----------------------------------------------------
BEGIN SINCOS ;SINE & COSINE - BGB.
INTERN SIN,COS;---------------------------------------------------
A←1 ↔ B←2 ↔ C←3
↑COS: SKIPA A,ARG1
↑SIN: SKIPA A,ARG1
FADR A,HALFPI ;COS(X) = SIN(X+π/2).
MOVM B,A↔CAMG B,[17B5]↔POP1J ;FOR SMALL X, SIN(X)=X.
;B ← (ABS(X)MODULO 2π)/HALFPI
;C ← QUADRANT 0, 1, 2 OR 3.
FDVR B,HALFPI
LAC C,B↔FIX C,233000
CAILE C,3↔GO[
TRZ C,3↔FSC C,233
FSBR B,C↔GO .-3] ;MODULO 2π.
GO .+1(C)↔GO .+4↔JFCL↔GO[
FSBRI B,(2.0)↔MOVNS B↔GO .+2] ;SIN(X+π)=SIN(-X)
FSBRI B,(4.0) ;SIN(X+2π)=SIN(X)
SKIPGE A↔MOVNS B ;SIN(-X) = -SIN(X).
;FOR -1 ≤ B ≤ +1 REPRESENTING -π/2 ≤ X ≤ +π/2,
;COMPUTE SINE(X) APPROXIMATION BY TAYLOR SERIES.
DAC B,C↔FMPR B,B
LAC A,[164475536722]↔FMP A,B
FAD A,[606315546346]↔FMP A,B
FAD A,[175506321276]↔FMP A,B
FAD A,[577265210372]↔FMP A,B
FAD A,HALFPI↔FMPR A,C↔POP1J
HALFPI: 201622077325 ;PI/2
LIT
BEND;-------------------------------------------------------------
SUBR(READARC)
CALL(REALIN)↔JUMPGE .+3
CAML[-6.3]↔POP0J
CAML[6.3]↔FMPR[0.0174533]↔POP0J
SUBR(REALIN)
BEGIN REALIN;
;<EXPR> ::= <EXPR>+<TERM>|<EXPR>-<TERM>|<TERM>
;<TERM> ::= <TERM>*<PRIMARY>|<TERM>/<PRIMARY>|<PRIMARY>
;<PRIMARY> ::= -<PRIMARY>|(<EXPR>)||π|<REAL NUMBER>
CALL(TERM)
CAIN 1,"+"↔GO[
PUSH P,0↔CALL(TERM)↔FADR 0,(P)
SUB P,[XWD 1,1]↔GO REALIN+1]
CAIN 1,"-"↔GO[
PUSH P,0↔CALL(TERM)↔MOVN 0,0↔FADR 0,(P)
SUB P,[XWD 1,1]↔GO REALIN+1]
POP0J↔POP0J
TERM: CALL(PRIMARY)
TERM2: CAIN 1,"*"↔GO[
PUSH P,0↔CALL(PRIMARY)↔FMPR 0,(P)
SUB P,[XWD 1,1]↔GO TERM2]
CAIN 1,"/"↔GO[
PUSH P,0↔CALL(PRIMARY)↔EXCH 0,(P)↔FDVR 0,(P)
SUB P,[XWD 1,1]↔GO TERM2]
POP0J
;BEGIN REALIN ; INPUT SMALL REAL NUMBER - BGB - 16 DEC 1972
;AC-0 INTEGER ACCUMULATION. AC-0 RETURNS REAL NUMBER.
;AC-1 CHARACTER. AC-1 RETURNS BREAK CHARACTER.
;AC-2 COUNTER OF DIGITS TO RIGHT OF DECIMAL POINT PLUS ONE.
;AC-3 MINUS SIGN FLAG.
PRIMARY:SETZ↔SETZB 2,3
L0: CALL(GETCHR)
CAIN 1," "↔GO .-2
CAIN 1,"-"↔GO[SETCMM 3↔GO L0]
CAIN 1,"π"↔GO[MOVE 0,[3.1415926]
GETRET: CALL(GETCHR)↔GO L3]
CAIN 1,"("↔GO[PUSH P,3↔CALL(REALIN)↔POP P,3
CAIN 1,")"↔GO GETRET
OUTSTR[ASCIZ/WARNING: MISSING ')'
/]↔ POP0J]
SKIPA
L1: CALL(GETCHR)
CAIN 1,";"↔GO L2↔CAIN 1,","↔GO L2
CAIE 1,"."↔GO .+3↔JUMPN 2,L2↔AOJA 2,L1
CAIL 1,"0"↔CAILE 1,"9"↔GO L2
JUMPN 2,[CAILE 2,4↔GO L1↔AOJA 2,.+1]
ANDI 1,17↔IMULI =10↔ADD 1↔GO L1
L2: FLOAT↔SOSLE 2↔FDVR[1.0↔10.0↔100.0↔1000.0↔10000.0](2)
L3: SKIPE 3↔MOVNS↔POP0J
BEND REALIN;12/16/72(BGB),14-MAR-73(TVR)-----------------------------
SUBR(DPYDOT)X,Y ;DISPLAY A DOT.
BEGIN DPYDOT
; PLACE A DOT AT LOCUS (X,Y).
; DILATION, ROTATION, TRANSLATION, & CLIP.
ACCUMULATORS{R,C}
LAC R,ARG1↔LAC C,ARG2
FMP R,SCALEY↔LAC 0,R ;DILATION.
FMP C,SCALEX↔LAC 1,C
FMP 0,SINE↔FMP R,COSINE ;ROTATION.
FMP 1,SINE↔FMP C,COSINE
FADR R,1↔FSBR C,0↔MOVNS R
FIXX R,↔ADD R,ROW ;TRANSLATION.
FIXX C,↔ADD C,COL
CAMGE R,QLO↔POP2J ;CLIP.
CAMLE R,QHI↔POP2J
SKIPGE C↔POP2J
CAILE C,=1728
SETO↔DOT(R,C)↔POP2J ;DISPLAY.
BEND DPYDOT;BGB 29 MAY 1973._________________________________________
SUBR(XCONIC)
END SA